home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / drawer.zip / EVENT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  2KB  |  93 lines
  1. {$L-,D-}
  2.  
  3. unit Events;
  4.  
  5. interface
  6.  
  7. type
  8.     EventType = (    LBUTTONDOWN,
  9.                     LBUTTONUP,
  10.                     RBUTTONDOWN,
  11.                     RBUTTONUP,
  12.                     MOVE,
  13.                     KEYPRESS );
  14.     Event = record
  15.                 typ  : EventType;
  16.                 x, y : word;
  17.                 ch1,
  18.                 ch2  : char;
  19.             end;
  20.  
  21. procedure EnableEvents;
  22. procedure GetEvent( var E : Event );
  23. procedure DisableEvents;
  24. procedure HidePointer;
  25. procedure ShowPointer;
  26.  
  27. implementation
  28.  
  29. uses Mouse, crt;
  30.  
  31. var
  32.     ButtonMask : word;
  33.     x, y : word;
  34.  
  35. procedure EnableEvents;
  36. var
  37.     b : word;
  38. begin
  39.     if not ms_init( b ) then RunError(190);
  40.     ms_show;
  41.     ms_read( x, y, ButtonMask );
  42. end;
  43.  
  44. procedure DisableEvents;
  45. begin
  46.     ms_hide;
  47. end;
  48.  
  49. procedure ShowPointer;
  50. begin
  51.     ms_show;
  52. end;
  53.  
  54. procedure HidePointer;
  55. begin
  56.     ms_hide;
  57. end;
  58.  
  59. procedure GetEvent( var E : Event );
  60. label
  61.     Again;
  62. var
  63.     NewBMask, NewX, NewY : word;
  64. begin
  65.  
  66. Again:
  67.     ms_read( NewX, NewY, NewBMask);
  68.     E.x := NewX; E.y := NewY;
  69.     if KeyPressed then begin
  70.         E.typ := KEYPRESS;
  71.         E.ch1 := ReadKey;
  72.         if E.ch1=chr(0) then E.ch2 := ReadKey
  73.         else E.ch2 := chr(0);
  74.         end
  75.     else if (NewBMask and left_b) <> (ButtonMask and left_b) then
  76.         if (NewBMask and left_b) = left_b
  77.             then E.typ := LBUTTONDOWN
  78.             else E.typ := LBUTTONUP
  79.     else if (NewBMask and right_b) <> (ButtonMask and right_b) then
  80.         if (NewBMask and right_b) = right_b
  81.             then E.typ := RBUTTONDOWN
  82.             else E.typ := RBUTTONUP
  83.     else if (NewX<>x) or (NewY<>y) then E.typ := MOVE
  84.     else goto Again;
  85.     x := NewX;
  86.     y := NewY;
  87.     ButtonMask := NewBMask;
  88. end;
  89.  
  90. begin
  91. end.
  92.  
  93.